home *** CD-ROM | disk | FTP | other *** search
/ CD Exchange / CD Exchange - Volume 1.iso / utils / misc / siod / scm / sets-mutabile.scm < prev    next >
Encoding:
Text File  |  1993-02-22  |  1.1 KB  |  34 lines
  1. (define (empty-set-m) (list 'set))
  2.  
  3. (define (adjoin-set-m! x set)
  4.         (if (element-of-set-m? x set)
  5.             set
  6.             (begin (set-cdr! set (cons x (cdr set)))
  7.                    set)))
  8.  
  9. (define (element-of-set-m? x set)
  10.         (define present #f)
  11.         (while (and (not present) 
  12.                     (not (null? set)))
  13.                (if (eqv? x (car set))
  14.                    (set! present #t)
  15.                    (set! set (cdr set))))
  16.         present)
  17.  
  18. (define (union-set-m set1 set2)
  19.         (define uni-set (empty-set-m))
  20.         (while (not (null? set2))
  21.                (adjoin-set-m! (car set2) set1)
  22.                (set! set2 (cdr set2))))
  23.  
  24. (define (intersection-set-m set1 set2)
  25.         (define int-set (empty-set-m))
  26.         (while (not (null? set2))
  27.                (when (element-of-set-m? (car set1) set2)
  28.                      (set-cdr! int-set (cons x (cdr int-set))))
  29.                (set! set2 (cdr set2)))
  30.         (set-cdr! set1 (cdr int-set)))
  31.                
  32. (define (empty-set-m? x)
  33.         (or (and (eq? (car x) 'set) (null? (cdr x))) (null? x)))
  34.